home *** CD-ROM | disk | FTP | other *** search
- {$X+,V-,B-}
- program who;
-
- { Adaption of a similar program privided with one of the other public
- domain TP API's.
-
- Example program for the nwConn unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
-
- uses nwMisc,nwBindry,nwConn,nwServ;
- {nwServ used for GetFileServerDateAndTime only}
-
- Type String25=string[25];
- PTuserInfo=^TuserInfo;
- TuserInfo=record
- objName :string25;
- objId :LongInt;
- TrueName :string25;
- LoginTime:TnovTime; { time of last logon }
- ConnNbr :byte; { 0= not logged on}
- next :PTuserInfo;
- end;
-
- var Param : string;
- DispAll,DispHelp : boolean;
- MyConnNbr : byte;
- MyServer : string;
- ConnInUse,UsersConnected,ConnNotLogIn:byte;
- startPtr : PTuserInfo;
-
- Procedure ScanBinderyUsers;
- Var lastObjSeen:LongInt;
- UserName :string;
- UserType :word;
- UserId :LongInt;
- Flag,Security:Byte;
- hp :boolean;
- nUser,lUser,wUser:PTuserInfo;
- tempStr :string;
- LogInfo :TloginControl;
-
- begin
- LastObjSeen:=-1;
- WHILE ScanBinderyObject('*',1 {OT_USER},LastObjSeen,
- UserName,UserType,UserId,Flag,Security,hp)
- do begin
- New(nUser);
- PstrCopy(nUser^.objName,UserName,25);
- nUser^.objId:=UserId;
- nUser^.ConnNbr:=0;
- nUser^.next:=NIL;
-
- GetObjectLoginControl(UserName,1 {ot_user},LogInfo);
- nUser^.LoginTime:=LogInfo.LastLoginTime;
-
- IF nwBindry.GetRealUserName(UserName,tempstr)
- then if (tempStr='')
- then tempStr:='_';
- PstrCopy(nUser^.TrueName,tempStr,25);
-
- wUser:=startPtr;
- While (wUser<>NIL) and (wUser^.objName<nUser^.objName)
- do begin lUser:=wUser;wUser:=wUser^.next; end;
- nUser^.next:=wUser;
- lUser^.next:=nUser;
-
- end;
- if nwBindry.Result<>$FC { no such object}
- then writeln('Error scanning Bindery.');
-
- end;
-
- Procedure DumpLoginTime(connNbr:byte;objName:string;objId:LongInt;time:TnovTime);
- Var nUser,lUser:PTuserInfo;
- begin
- lUser:=startPtr^.next;
- while (lUser<>NIL) and (luser^.objId<>objId)
- do lUser:=lUser^.next;
- if lUser<>NIL
- then begin
- if lUser^.ConnNbr=0 { first time the user is found at some connection }
- then begin
- lUser^.LoginTime:=time;
- lUser^.ConnNbr:=ConnNbr;
- end
- else begin { user logged in at multiple connections }
- new(nUser);
- nUser^:=lUser^;
- {nUser^.next:=lUser^.next}
- nUser^.LoginTime:=time;
- nUser^.ConnNbr:=ConnNbr;
- lUser^.next:=nUser;
- end;
- end
- else begin
- writeln('SECURITY WARNING: USER ''',objName,''' @ connection:',connNbr);
- writeln(' IS LOGGED IN W/O CORRESPONDING BINDERY OBJECT.');
- end
- end;
-
- procedure DisplayHeader;
- Var connId :byte;
- username:string;
- objType :word;
- objID :LongInt;
- dateTime:TnovTime;
- begin
- UpString(Param);
- If NOT (GetPreferredConnectionID(connId) and (connId<>0))
- then if NOT (GetDefaultConnectionID(connId) and (connId<>0))
- then GetPrimaryConnectionId(connId);
- GetFileServerName(connId,MyServer);
- GetConnectionNumber(MyConnNbr);
- GetConnectionInformation(MyconnNbr,username,objType,objID,datetime);
- if Param='' then writeln('List of currently logged on users for server ',MyServer)
- else writeln('List for user ',Param,' on ',MyServer,'.');
- writeln;
- writeln('Con: Name: Login/off Time:');
- writeln('--- -------------------- -------------------------');
- end;
-
-
- procedure GetConnectedUsers;
- Var connNbr:byte;
- objName:string;
- objType:word;
- objId :LongInt;
- LogTime:TnovTime;
- {serverInfo:TFileServerInformation;}
- begin
- ConnInUse:=0;
- UsersConnected:=0;
- ConnNotLogIn:=0;
- { To determine the maximum number of connections allowed by the
- license, you would normally use the
- nwServ.GetFileServerInformation(servername,serverInfo)
- call. For now, we'll suppose there are max. 250 connectios allowed. }
-
- for connNbr := 1 to 250 {serverinfo.ConnectionsMax}
- do begin
- IF GetConnectionInformation(connNbr,objName,objType,objId,LogTime)
- then begin
- if objName='NOT-LOGGED-IN'
- then begin
- inc(ConnNotLogIn);
- inc(connInUse);
- DumpLoginTime(connNbr,objName,objId,LogTime);{ logOUT time }
- end
- else if objType=1 {OT_USER}
- then begin
- inc(ConnInUse);
- inc(UsersConnected);
- DumpLoginTime(connNbr,objName,objId,LogTime);{ logIN }
- end
- else inc(connInUse);
- end
- end; {do}
- end;
-
-
- procedure DisplayAllUsers;
- Var lUser :PTuserInfo;
- time,tempStr:string;
- Begin
- lUser:=startPtr^.next;
- while lUser<>NIL
- do begin
- if (param='') or (pos(param,lUser^.objName)>0)
- then begin
- if lUser^.ConnNbr=0
- then begin
- if DispAll and (lUser^.objName<>'NOT-LOGGED-IN')
- then begin
- PstrCopy(tempStr,lUser^.objName,20);
- write('N/A ',tempStr);
- if lUser^.LoginTime.day<>0
- then begin
- NovTime2String(lUser^.LoginTime,time);
- time[1]:='?';time[2]:='?';time[3]:='?';
- writeln(' ',time);
- end
- else writeln(' ------not available------');
- writeln('':5,lUser^.TrueName);
- end
- end
- else begin
-
- NovTime2String(lUser^.LoginTime,time);
- PstrCopy(tempStr,lUser^.objName,20);
-
- write(lUser^.connNbr:3);
- if Luser^.ConnNbr=MyConnNbr
- then write(' *')
- else write(' ');
-
- writeln(tempstr,' ',time);
- writeln('':5,lUser^.TrueName);
- end;
- end;
- lUser:=lUser^.next
- end;
- end;
-
-
- procedure DisplayFooter;
- Var now:TnovTime;
- nowStr:string;
- remainder:byte;
- begin
- getFileServerDateAndTime(now);
- NovTime2String(now,nowStr);
- If UsersConnected=1 then write('1 user is');
- if UsersConnected>1 then write(UsersConnected,' users are');
- if UsersConnected>0 then writeln(' logged into ',MyServer,' as of ',nowStr);
- IF ConnNotLogIn=1 then write('1 connection is');
- IF ConnNotLogIn>1 then write(ConnNotLogIn,' connections are');
- IF ConnNotLogIn>0 then writeln(' in use, but the workstation has logged out.');
- remainder:=ConnInUse-UsersConnected-ConnNotLogIn;
- IF remainder>0 then writeln(remainder,' connection(s) used by non-user objects.');
- end;
-
- procedure credits;
- begin
- writeln;
- writeln('WHO: Displays a list of currently logged in users.');
- writeln;
- writeln('SYNTAX: WHO [servername/][username] [/A]');
- writeln;
- writeln('Servername has to match an existing server.');
- writeln('All users with ''username'' contained in them wil be displayed.');
- writeln;
- writeln('Example: WHO Display everyone');
- writeln(' WHO username Display a particular user.');
- writeln(' WHO server/ Display a different server.');
- writeln;
- halt(0);
- end;
-
-
- procedure ChangeServer; { change default server to something else }
- var ServerChanged:Boolean;
- p,connId:byte;
- NewServer : string;
- servername : string;
- begin
- ServerChanged:=False;
- p := pos('/',Param);
- NewServer := copy(Param,1,p-1);
- UpString(NewServer);
- Param := copy(Param,p+1,255);
- for connId := 1 to 8
- do begin
- GetFileServerName(connId,servername);
- if servername=NewServer
- then begin
- serverChanged:=True;
- SetPreferredConnectionId(connId);
- end;
- end;
- if NOT ServerChanged
- then begin
- writeln('Server ',NewServer,' not found.');
- halt(1);
- end;
- end;
-
- Var OldConnId:Byte;
- nliConn:PTuserInfo;
-
- begin {---------main-----------------------------------------------------}
- New(startPtr);
- New(nliConn);
- nliConn^.objName:='NOT-LOGGED-IN';
- nliConn^.objId:=0;
- nliConn^.TrueName:='';
- nliConn^.next:=NIL;
- nliConn^.connNbr:=0;
- startPtr^.next:=nliConn;
- startPtr^.objName:=#0;
-
- if paramcount > 0
- then Param := paramstr(1)
- else Param := '';
- DispAll:=(paramCount > 0)
- and ( (pos('/A',paramstr(1))=1)
- or (pos('/a',paramStr(1))=1)
- );
- If dispall then param:='';
- DispAll:=DispAll or ( (paramCount > 1)
- and ( (pos('/A',paramstr(2))=1)
- or (pos('/a',paramStr(2))=1)
- )
- );
- UpString(Param);
- DispHelp:=(Param = '?') or (Pos('/H',Param)=1);
-
-
- GetPreferredConnectionId(OldConnId);
- if DispHelp then credits;
- if pos('/',Param) > 1 then ChangeServer;
- ScanBinderyUsers;
- GetConnectedUsers;
- DisplayHeader;
- DisplayAllUsers;
- DisplayFooter;
- SetPreferredConnectionId(OldConnId);
- end.
-
-